# dependencies
library(tidyverse)
library(knitr)
library(kableExtra)
library(brms)
library(parallel)
library(tidybayes)
library(bayestestR)
library(sjPlot)
library(psych)
library(rsample)
library(broom)
library(purrr)
library(IATscores)
library(lavaan)
library(semTools)
library(modelr)
library(furrr)
library(caret)
library(e1071)
# set up parallel processing
future::plan(multiprocess)
# knitr options
options(knitr.kable.NA = "/")
# set seed for bootstrapping reproducibility
set.seed(42)
# create necessary folder
dir.create("models")All dependent variables (self-reported evaluations and IAT D2 scores) were standardized (by 1 SD) after exclusions and prior to analysis condition (see Lorah, 2018: https://doi.org/10.1186/s40536-018-0061-2). This was done within each level of both IV (i.e., by Source Valence condition [positive vs. negative], and by Video Content [Genuine vs. Deepfaked]). As such, the beta estimates obtained from the Bayesian models (see research questions and data analysis plans below) therefore represent standardized beta values (\(\beta\) rather than \(B\)). More importantly, the nature of this standardization makes these estimates somewhat comparable to the frequentist standardized effect size metric Cohen’s \(d\), as both are a differences in (estimated) means as a proportion of SD although they should not be treated as equivalent. Effect size magnitude here can therefore be thought of along comparable scales as Cohen’s \(d\). As such, to aid interpretability, the point estimates of effect size will be reported as \(\delta\) (delta).
# full data
data_processed <- read.csv("../data/processed/4_data_participant_level_with_hand_scoring.csv") %>%
# include only experiment 7
filter(experiment == 7) %>%
# set factor levels for t test comparisons
mutate(source_valence = fct_relevel(source_valence,
"negative",
"positive"),
experiment_condition = fct_relevel(experiment_condition,
"genuine",
"deepfaked"),
deepfake_detection_closed = fct_relevel(tolower(deepfake_detection_closed),
"genuine",
"deepfaked"),
deepfake_awareness_closed = fct_relevel(deepfake_awareness_closed,
"unaware",
"aware"))
# apply exclusions
data_after_exclusions <- data_processed %>%
filter(exclude_subject == FALSE &
exclude_implausible_intervention_linger == FALSE) %>%
# standardize DVs by 1SD within each experiment and their conditions
group_by(experiment, experiment_condition, source_valence) %>%
mutate(mean_self_reported_evaluation = mean_self_reported_evaluation/sd(mean_self_reported_evaluation),
IAT_D2 = IAT_D2/sd(IAT_D2),
mean_intentions = mean_intentions/sd(mean_intentions)) %>%
ungroup()
# item level for iat
data_iat_item_level_after_exclusions <- read_csv("../data/processed/2.4_data_iat_item_level.csv") %>%
# exclude the same participants as above
semi_join(rename(data_after_exclusions, subject_original = subject), by = "subject_original") ggplot(data_after_exclusions, aes(mean_self_reported_evaluation)) +
geom_density() +
facet_wrap( ~ experiment_condition + source_valence) +
ggtitle("Standardized scores")ggplot(data_after_exclusions, aes(IAT_D2)) +
geom_density() +
facet_wrap( ~ experiment_condition + source_valence) +
ggtitle("Standardized scores")ggplot(data_after_exclusions, aes(mean_intentions)) +
geom_density() +
facet_wrap( ~ experiment_condition + source_valence) +
ggtitle("Standardized scores")data_processed %>%
summarise(n = n(),
excluded_n = sum(exclude_subject != FALSE |
exclude_implausible_intervention_linger != FALSE, na.rm = TRUE),
excluded_percent = (excluded_n / n) *100) %>%
mutate_if(is.numeric, round, digits = 1) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| n | excluded_n | excluded_percent |
|---|---|---|
| 828 | 192 | 23.2 |
data_after_exclusions %>%
summarise(n = n(),
age_mean = mean(age, na.rm = TRUE),
age_sd = sd(age, na.rm = TRUE)) %>%
mutate_if(is.numeric, round, digits = 1) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| n | age_mean | age_sd |
|---|---|---|
| 635 | 35.7 | 13 |
data_after_exclusions %>%
count(gender) %>%
spread(gender, n) %>%
kable(knitr.kable.NA = "/", align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| female | male | Non-binary | Prefer to self-discribe |
|---|---|---|---|
| 387 | 240 | 7 | 1 |
model_sr <- "scale =~ ratings_bad_good + ratings_dislike_like + ratings_negative_positive"
fit_cfa_sr <- data_after_exclusions %>%
cfa(model = model_sr, data = .)
results_reliability_sr <- fit_cfa_sr %>%
reliability() %>%
as.data.frame() %>%
rownames_to_column(var = "metric") %>%
select(metric, estimate = scale) %>%
filter(metric %in% c("alpha",
"omega2")) %>%
mutate(metric = recode(metric,
"alpha" = "alpha",
"omega2" = "omega_t"),
estimate = round(estimate, 3))
results_reliability_sr %>%
kable(knitr.kable.NA = "/", align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| metric | estimate |
|---|---|
| alpha | 0.987 |
| omega_t | 0.987 |
split half
results_iat_split_half_reliability <- data_iat_item_level_after_exclusions %>%
SplitHalf.D2(IATdata = .) %>%
mutate(algorithm = ifelse(algorithm == "p2112", "D2", algorithm),
splithalf = round(splithalf, 3))## [1] "2020-12-08 23:30:14: Applying parameter P4 = dist"
## [1] "2020-12-08 23:30:14: Applying parameters P1 and P2"
## [1] "2020-12-08 23:30:14: Applying parameter P3 = dscore"
## [1] "2020-12-08 23:30:14: Applying parameters P1 and P2"
## [1] "2020-12-08 23:30:14: Applying parameter P3 = dscore"
## [1] "2020-12-08 23:30:14: IAT scores have been computed"
## [1] "2020-12-08 23:30:14: Applying parameter P4 = dist"
## [1] "2020-12-08 23:30:14: Applying parameters P1 and P2"
## [1] "2020-12-08 23:30:14: Applying parameter P3 = dscore"
## [1] "2020-12-08 23:30:15: Applying parameters P1 and P2"
## [1] "2020-12-08 23:30:15: Applying parameter P3 = dscore"
## [1] "2020-12-08 23:30:15: IAT scores have been computed"
results_iat_split_half_reliability %>%
kable(knitr.kable.NA = "/", align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| algorithm | splithalf |
|---|---|
| D2 | 0.862 |
model_bi <- "scale =~ behavioral_intentions_share + behavioral_intentions_subscribe + behavioral_intentions_recommend"
fit_cfa_bi <- data_after_exclusions %>%
cfa(model = model_bi, data = .)
results_reliability_bi <- fit_cfa_bi %>%
reliability() %>%
as.data.frame() %>%
rownames_to_column(var = "metric") %>%
select(metric, estimate = scale) %>%
filter(metric %in% c("alpha",
"omega2")) %>%
mutate(metric = recode(metric,
"alpha" = "alpha",
"omega2" = "omega_t"),
estimate = round(estimate, 3))
results_reliability_bi %>%
kable(knitr.kable.NA = "/", align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| metric | estimate |
|---|---|
| alpha | 0.939 |
| omega_t | 0.939 |
H1 hypotheses were tested using a Bayesian linear model to estimate a 95% Credible Interval on standardized effect size change in evaluations between Source Valence conditions. Credible Intervals whose lower bounds were > 0 were considered evidence in support of a given hypothesis.
For H2, if the lower bound of the 95% CI of the genuine condition is < the lower bound of the 90% CI of the Deepfaked condition (i.e., the difference between Source Valence conditions in each subgroups), this as considered evidence in support of the alternative hypothesis (i.e., evidence of non-inferiority in estimated means; that Deepfakes are as good as genuine content).
data_after_exclusions %>%
select(source_valence,
experiment_condition) %>%
drop_na() %>%
count(experiment_condition,
source_valence) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| experiment_condition | source_valence | n |
|---|---|---|
| genuine | negative | 155 |
| genuine | positive | 149 |
| deepfaked | negative | 160 |
| deepfaked | positive | 171 |
fit_confirmatory_selfreport <-
brm(formula = mean_self_reported_evaluation ~ source_valence * experiment_condition,
family = gaussian(),
data = data_after_exclusions,
file = "models/fit_confirmatory_selfreport",
prior = prior(normal(0, 10)),
iter = 10000,
warmup = 3000,
control = list(adapt_delta = 0.99), # to avoid divergent transitions
chains = 4,
cores = parallel::detectCores())## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: mean_self_reported_evaluation ~ source_valence * experiment_condition
## Data: data_after_exclusions (Number of observations: 635)
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
## total post-warmup samples = 28000
##
## Population-Level Effects:
## Estimate Est.Error
## Intercept -1.29 0.08
## source_valencepositive 2.59 0.12
## experiment_conditiondeepfaked -0.13 0.11
## source_valencepositive:experiment_conditiondeepfaked -0.22 0.16
## l-95% CI u-95% CI Rhat
## Intercept -1.44 -1.13 1.00
## source_valencepositive 2.36 2.82 1.00
## experiment_conditiondeepfaked -0.35 0.10 1.00
## source_valencepositive:experiment_conditiondeepfaked -0.53 0.09 1.00
## Bulk_ESS Tail_ESS
## Intercept 14299 18178
## source_valencepositive 12792 16246
## experiment_conditiondeepfaked 12963 16691
## source_valencepositive:experiment_conditiondeepfaked 11313 15687
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 1.00 0.03 0.95 1.06 1.00 19249 17433
##
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.
check_prior(fit_confirmatory_selfreport) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | Prior_Quality |
|---|---|
| b_Intercept | uninformative |
| b_source_valencepositive | uninformative |
| b_experiment_conditiondeepfaked | uninformative |
| b_source_valencepositive.experiment_conditiondeepfaked | uninformative |
# plot_model(fit_confirmatory_selfreport)
plot_model(fit_confirmatory_selfreport, type = "pred", terms = c("source_valence", "experiment_condition"))# percent moderation
draws_sr <-
bind_cols(
select(spread_draws(fit_confirmatory_selfreport, b_source_valencepositive), b_source_valencepositive),
select(spread_draws(fit_confirmatory_selfreport, b_experiment_conditiondeepfaked), b_experiment_conditiondeepfaked),
select(spread_draws(fit_confirmatory_selfreport, `b_source_valencepositive:experiment_conditiondeepfaked`), `b_source_valencepositive:experiment_conditiondeepfaked`)
) %>%
rename(main_valence = b_source_valencepositive,
main_experiment_condition = b_experiment_conditiondeepfaked,
interaction = `b_source_valencepositive:experiment_conditiondeepfaked`) %>%
mutate(effect_genuine = main_valence,
effect_deepfaked = main_valence + interaction,
#percent_moderation = (main_experiment_condition + interaction)/main_valence *100, # alt method, same result
percent_comparison = (effect_deepfaked/effect_genuine)*100)
# results
estimates_sr <-
map_estimate(draws_sr) %>%
full_join(bayestestR::hdi(draws_sr, ci = .95) %>%
rename(CI_95_lower = CI_low,
CI_95_upper = CI_high) %>%
as_tibble(),
by = "Parameter") %>%
full_join(bayestestR::hdi(draws_sr, ci = .90) %>%
as_tibble() %>%
rename(CI_90_lower = CI_low,
CI_90_upper = CI_high),
by = "Parameter") %>%
full_join(draws_sr %>%
select(-percent_comparison) %>%
gather(Parameter, value) %>%
group_by(Parameter) %>%
summarize(pd = mean(value > 0)) %>%
mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
ungroup() %>%
select(Parameter, p),
by = "Parameter") %>%
select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
CI_90_lower, CI_90_upper, p)
# results table
estimates_sr %>%
mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | MAP_Estimate | CI_95_lower | CI_95_upper | CI_90_lower | CI_90_upper | p |
|---|---|---|---|---|---|---|
| main_valence | 2.60 | 2.36 | 2.81 | 2.40 | 2.78 | 0.0000000 |
| main_experiment_condition | -0.12 | -0.34 | 0.10 | -0.31 | 0.06 | 0.1314286 |
| interaction | -0.21 | -0.53 | 0.09 | -0.49 | 0.04 | 0.0815000 |
| effect_genuine | 2.60 | 2.36 | 2.81 | 2.40 | 2.78 | 0.0000000 |
| effect_deepfaked | 2.35 | 2.15 | 2.59 | 2.18 | 2.55 | 0.0000000 |
| percent_comparison | 91.32 | 80.18 | 103.31 | 81.90 | 101.33 | / |
# hypothesis testing
H1a <- ifelse((estimates_sr %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)) > 0,
"Accepted", "Rejected")
H1b <- ifelse((estimates_sr %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_95_lower)) > 0,
"Accepted", "Rejected")
H2a <- ifelse((estimates_sr %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_90_lower)) >
(estimates_sr %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)),
"Accepted", "Rejected")
comparison_string_sr <-
paste0("Deepfakes are ",
estimates_sr %>% filter(Parameter == "percent_comparison") %>% pull(MAP_Estimate) %>% round(1),
"% (95% CI [",
estimates_sr %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_lower) %>% round(1),
", ",
estimates_sr %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_upper) %>% round(1),
"]) as effective as genuine content in establishing self-reported evaluations")H1a
The content of the genuine videos (i.e., Source Valence) will influence participants’ self-reported evaluations.
H1b
The content of the Deepfaked videos (i.e., Source Valence) will influence participants’ self-reported evaluations.
H2a
Change in self-reported evaluations (i.e., between Source Valence conditions) induced by Deepfaked video content will be non-inferior to genuine content.
fit_confirmatory_implicit <-
brm(formula = IAT_D2 ~ source_valence * experiment_condition,
family = gaussian(),
data = data_after_exclusions,
file = "models/fit_confirmatory_implicit",
prior = prior(normal(0, 10)),
iter = 10000,
warmup = 3000,
control = list(adapt_delta = 0.99), # to avoid divergent transitions
chains = 4,
cores = parallel::detectCores())## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: IAT_D2 ~ source_valence * experiment_condition
## Data: data_after_exclusions (Number of observations: 635)
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
## total post-warmup samples = 28000
##
## Population-Level Effects:
## Estimate Est.Error
## Intercept -0.04 0.08
## source_valencepositive 1.39 0.12
## experiment_conditiondeepfaked 0.17 0.11
## source_valencepositive:experiment_conditiondeepfaked -0.03 0.16
## l-95% CI u-95% CI Rhat
## Intercept -0.20 0.11 1.00
## source_valencepositive 1.16 1.61 1.00
## experiment_conditiondeepfaked -0.05 0.39 1.00
## source_valencepositive:experiment_conditiondeepfaked -0.35 0.28 1.00
## Bulk_ESS Tail_ESS
## Intercept 14281 18619
## source_valencepositive 12853 16815
## experiment_conditiondeepfaked 13230 16644
## source_valencepositive:experiment_conditiondeepfaked 11380 15882
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 1.00 0.03 0.95 1.06 1.00 19510 17391
##
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.
check_prior(fit_confirmatory_implicit) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | Prior_Quality |
|---|---|
| b_Intercept | uninformative |
| b_source_valencepositive | uninformative |
| b_experiment_conditiondeepfaked | uninformative |
| b_source_valencepositive.experiment_conditiondeepfaked | uninformative |
#plot_model(fit_confirmatory_implicit)
plot_model(fit_confirmatory_implicit, type = "pred", terms = c("source_valence", "experiment_condition"))# percent moderation
draws_imp <-
bind_cols(
select(spread_draws(fit_confirmatory_implicit, b_source_valencepositive), b_source_valencepositive),
select(spread_draws(fit_confirmatory_implicit, b_experiment_conditiondeepfaked), b_experiment_conditiondeepfaked),
select(spread_draws(fit_confirmatory_implicit, `b_source_valencepositive:experiment_conditiondeepfaked`), `b_source_valencepositive:experiment_conditiondeepfaked`)
) %>%
rename(main_valence = b_source_valencepositive,
main_experiment_condition = b_experiment_conditiondeepfaked,
interaction = `b_source_valencepositive:experiment_conditiondeepfaked`) %>%
mutate(effect_genuine = main_valence,
effect_deepfaked = main_valence + interaction,
#percent_moderation = (main_experiment_condition + interaction)/main_valence *100, # alt method, same result
percent_comparison = (effect_deepfaked/effect_genuine)*100)
# results table
estimates_imp <-
map_estimate(draws_imp) %>%
full_join(bayestestR::hdi(draws_imp, ci = .95) %>%
rename(CI_95_lower = CI_low,
CI_95_upper = CI_high) %>%
as_tibble(),
by = "Parameter") %>%
full_join(bayestestR::hdi(draws_imp, ci = .90) %>%
as_tibble() %>%
rename(CI_90_lower = CI_low,
CI_90_upper = CI_high),
by = "Parameter") %>%
full_join(draws_imp %>%
select(-percent_comparison) %>%
gather(Parameter, value) %>%
group_by(Parameter) %>%
summarize(pd = mean(value > 0)) %>%
mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
ungroup() %>%
select(Parameter, p),
by = "Parameter") %>%
select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
CI_90_lower, CI_90_upper, p)
estimates_imp %>%
mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | MAP_Estimate | CI_95_lower | CI_95_upper | CI_90_lower | CI_90_upper | p |
|---|---|---|---|---|---|---|
| main_valence | 1.37 | 1.17 | 1.62 | 1.19 | 1.57 | 0.0000000 |
| main_experiment_condition | 0.18 | -0.05 | 0.39 | -0.02 | 0.35 | 0.0697857 |
| interaction | -0.03 | -0.35 | 0.28 | -0.30 | 0.23 | 0.4175714 |
| effect_genuine | 1.37 | 1.17 | 1.62 | 1.19 | 1.57 | 0.0000000 |
| effect_deepfaked | 1.36 | 1.14 | 1.57 | 1.17 | 1.53 | 0.0000000 |
| percent_comparison | 96.68 | 76.05 | 121.10 | 78.88 | 116.39 | / |
# hypothesis testing
H1c <- ifelse((estimates_imp %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)) > 0,
"Accepted", "Rejected")
H1d <- ifelse((estimates_imp %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_95_lower)) > 0,
"Accepted", "Rejected")
H2b <- ifelse((estimates_imp %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_90_lower)) >
(estimates_imp %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)),
"Accepted", "Rejected")
comparison_string_imp <-
paste0("Deepfakes are ",
estimates_imp %>% filter(Parameter == "percent_comparison") %>% pull(MAP_Estimate) %>% round(1),
"% (95% CI [",
estimates_imp %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_lower) %>% round(1),
", ",
estimates_imp %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_upper) %>% round(1),
"]) as effective as genuine content in establishing self-reported evaluations")H1c
The content of the genuine videos (i.e., Source Valence) will influence participants’ IAT D2 scores.
H1d
The content of the Deepfaked videos (i.e., Source Valence) will influence participants’ IAT D2 scores.
H2b
Change in IAT D2 scores (i.e., between Source Valence conditions) induced by Deepfaked video content will be non-inferior to genuine content.
fit_confirmatory_intentions <-
brm(formula = mean_intentions ~ source_valence * experiment_condition, # no random effect for experiment as only exp 6 assessed intentions
family = gaussian(),
data = data_after_exclusions,
file = "models/fit_confirmatory_intentions",
prior = prior(normal(0, 10)),
iter = 10000,
warmup = 3000,
control = list(adapt_delta = 0.99), # to avoid divergent transitions
chains = 4,
cores = parallel::detectCores())## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: mean_intentions ~ source_valence * experiment_condition
## Data: data_after_exclusions (Number of observations: 635)
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
## total post-warmup samples = 28000
##
## Population-Level Effects:
## Estimate Est.Error
## Intercept -4.84 0.08
## source_valencepositive 2.59 0.11
## experiment_conditiondeepfaked -0.43 0.11
## source_valencepositive:experiment_conditiondeepfaked 0.10 0.16
## l-95% CI u-95% CI Rhat
## Intercept -5.00 -4.68 1.00
## source_valencepositive 2.36 2.81 1.00
## experiment_conditiondeepfaked -0.65 -0.20 1.00
## source_valencepositive:experiment_conditiondeepfaked -0.22 0.41 1.00
## Bulk_ESS Tail_ESS
## Intercept 12719 17823
## source_valencepositive 11272 14831
## experiment_conditiondeepfaked 11101 15664
## source_valencepositive:experiment_conditiondeepfaked 9559 13598
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 1.00 0.03 0.95 1.06 1.00 19590 17095
##
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.
check_prior(fit_confirmatory_intentions) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | Prior_Quality |
|---|---|
| b_Intercept | uninformative |
| b_source_valencepositive | uninformative |
| b_experiment_conditiondeepfaked | uninformative |
| b_source_valencepositive.experiment_conditiondeepfaked | uninformative |
#plot_model(fit_confirmatory_intentions)
plot_model(fit_confirmatory_intentions, type = "pred", terms = c("source_valence", "experiment_condition"))# percent moderation
draws_intentions <-
bind_cols(
select(spread_draws(fit_confirmatory_intentions, b_source_valencepositive), b_source_valencepositive),
select(spread_draws(fit_confirmatory_intentions, b_experiment_conditiondeepfaked), b_experiment_conditiondeepfaked),
select(spread_draws(fit_confirmatory_intentions, `b_source_valencepositive:experiment_conditiondeepfaked`), `b_source_valencepositive:experiment_conditiondeepfaked`)
) %>%
rename(main_valence = b_source_valencepositive,
main_experiment_condition = b_experiment_conditiondeepfaked,
interaction = `b_source_valencepositive:experiment_conditiondeepfaked`) %>%
mutate(effect_genuine = main_valence,
effect_deepfaked = main_valence + interaction,
#percent_moderation = (main_experiment_condition + interaction)/main_valence *100, # alt method, same result
percent_comparison = (effect_deepfaked/effect_genuine)*100)
# results table
estimates_intentions <-
map_estimate(draws_intentions) %>%
full_join(bayestestR::hdi(draws_intentions, ci = .95) %>%
rename(CI_95_lower = CI_low,
CI_95_upper = CI_high) %>%
as_tibble(),
by = "Parameter") %>%
full_join(bayestestR::hdi(draws_intentions, ci = .90) %>%
as_tibble() %>%
rename(CI_90_lower = CI_low,
CI_90_upper = CI_high),
by = "Parameter") %>%
full_join(draws_intentions %>%
select(-percent_comparison) %>%
gather(Parameter, value) %>%
group_by(Parameter) %>%
summarize(pd = mean(value > 0)) %>%
mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
ungroup() %>%
select(Parameter, p),
by = "Parameter") %>%
select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
CI_90_lower, CI_90_upper, p)
estimates_intentions %>%
mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | MAP_Estimate | CI_95_lower | CI_95_upper | CI_90_lower | CI_90_upper | p |
|---|---|---|---|---|---|---|
| main_valence | 2.59 | 2.37 | 2.82 | 2.40 | 2.78 | 0.0000000 |
| main_experiment_condition | -0.44 | -0.65 | -0.20 | -0.61 | -0.23 | 0.0000357 |
| interaction | 0.11 | -0.21 | 0.42 | -0.17 | 0.36 | 0.2766429 |
| effect_genuine | 2.59 | 2.37 | 2.82 | 2.40 | 2.78 | 0.0000000 |
| effect_deepfaked | 2.68 | 2.47 | 2.90 | 2.51 | 2.87 | 0.0000000 |
| percent_comparison | 102.64 | 92.28 | 116.89 | 93.40 | 113.96 | / |
# hypothesis testing
H1e <- ifelse((estimates_intentions %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)) > 0,
"Accepted", "Rejected")
H1f <- ifelse((estimates_intentions %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_95_lower)) > 0,
"Accepted", "Rejected")
H2c <- ifelse((estimates_intentions %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_90_lower)) >
(estimates_intentions %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)),
"Accepted", "Rejected")
comparison_string_intentions <-
paste0("Deepfakes are ",
estimates_intentions %>% filter(Parameter == "percent_comparison") %>% pull(MAP_Estimate) %>% round(1),
"% (95% CI [",
estimates_intentions %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_lower) %>% round(1),
", ",
estimates_intentions %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_upper) %>% round(1),
"]) as effective as genuine content in establishing self-reported evaluations")H1e
The content of the genuine videos (i.e., Source Valence) will influence participants’ behavioral intention responses.
H1f
The content of the Deepfaked videos (i.e., Source Valence) will influence participants’ behavioral intention responses.
H2c
Change in behavioral intentions (i.e., between Source Valence conditions) induced by Deepfaked video content will be non-inferior to genuine content.
data_after_exclusions %>%
count(experiment_condition,
deepfake_detection_closed) %>%
drop_na() %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| experiment_condition | deepfake_detection_closed | n |
|---|---|---|
| genuine | genuine | 184 |
| genuine | deepfaked | 120 |
| deepfaked | genuine | 109 |
| deepfaked | deepfaked | 221 |
data_classifications <- data_after_exclusions %>%
select(experiment_condition, deepfake_detection_closed) %>%
drop_na()
truth <- factor(data_classifications$experiment_condition,
levels = rev(c("genuine", "deepfaked")))
pred <- factor(data_classifications$deepfake_detection_closed,
levels = rev(c("genuine", "deepfaked")))
cm <- confusionMatrix(table(pred, truth))
fit_confirmatory_classification <-
as_tibble(cm$byClass, rownames = "parameter") %>%
spread(parameter, value) %>%
mutate(balanced_accuracy = `Balanced Accuracy`,
false_negative_rate = 1 - Sensitivity,
false_positive_rate = 1 - Specificity,
informedness = Sensitivity + Specificity - 1) %>%
select(balanced_accuracy,
informedness,
false_negative_rate,
false_positive_rate) %>%
gather(variable, observed, c(balanced_accuracy,
informedness,
false_negative_rate,
false_positive_rate))# create bootstraps using out of bag method. makes a df with values that are collapsed dfs.
boots <- data_classifications %>%
bootstraps(times = 2000)
# function to bootstrap classification stats and return a tibble
bootstrap_categorization_stats <- function(split) {
truth <- factor(analysis(split)$experiment_condition,
levels = rev(c("genuine", "deepfaked")))
pred <- factor(analysis(split)$deepfake_detection_closed,
levels = rev(c("genuine", "deepfaked")))
cm <- confusionMatrix(table(pred, truth))
results <-
as_tibble(cm$byClass, rownames = "parameter") %>%
spread(parameter, value) %>%
mutate(balanced_accuracy = `Balanced Accuracy`,
false_negative_rate = 1 - Sensitivity,
false_positive_rate = 1 - Specificity,
informedness = Sensitivity + Specificity - 1) %>%
select(balanced_accuracy,
informedness,
false_negative_rate,
false_positive_rate)
return(results)
}
# apply to each bootstrap
fit_confirmatory_classification_bootstraps <- boots %>%
mutate(categorization_stats = future_map(splits, bootstrap_categorization_stats)) %>%
select(-splits) %>%
unnest(categorization_stats)classifications <- fit_confirmatory_classification_bootstraps %>%
gather(variable, value, c(balanced_accuracy,
informedness,
false_negative_rate,
false_positive_rate)) %>%
group_by(variable) %>%
summarize(ci_lower = quantile(value, 0.025),
ci_upper = quantile(value, 0.975),
.groups = "drop") %>%
full_join(fit_confirmatory_classification, by = "variable") %>%
mutate_if(is.numeric, round, digits = 2) %>%
select(variable, observed, ci_lower, ci_upper)
classifications %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| variable | observed | ci_lower | ci_upper |
|---|---|---|---|
| balanced_accuracy | 0.64 | 0.60 | 0.67 |
| false_negative_rate | 0.33 | 0.28 | 0.38 |
| false_positive_rate | 0.39 | 0.34 | 0.45 |
| informedness | 0.27 | 0.20 | 0.35 |
H3: Participants are poor at making accurate and informed judgements about whether online video content is genuine or Deepfaked. Our predictions here are descriptive/continuous rather than involving cut-off based inference rules.
Same descriptive predictions as above.
data_after_exclusions %>%
filter(deepfake_awareness_closed == "aware") %>%
count(experiment_condition,
deepfake_detection_closed) %>%
drop_na() %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| experiment_condition | deepfake_detection_closed | n |
|---|---|---|
| genuine | genuine | 100 |
| genuine | deepfaked | 62 |
| deepfaked | genuine | 50 |
| deepfaked | deepfaked | 145 |
data_classifications_subset <- data_after_exclusions %>%
filter(deepfake_awareness_closed == "aware") %>%
select(experiment_condition, deepfake_detection_closed) %>%
drop_na()
truth_subset <- factor(data_classifications_subset$experiment_condition,
levels = rev(c("genuine", "deepfaked")))
pred_subset <- factor(data_classifications_subset$deepfake_detection_closed,
levels = rev(c("genuine", "deepfaked")))
cm_subset <- confusionMatrix(table(pred_subset, truth_subset))
fit_confirmatory_classification_subset <-
as_tibble(cm_subset$byClass, rownames = "parameter") %>%
spread(parameter, value) %>%
mutate(balanced_accuracy = `Balanced Accuracy`,
false_negative_rate = 1 - Sensitivity,
false_positive_rate = 1 - Specificity,
informedness = Sensitivity + Specificity - 1) %>%
select(balanced_accuracy,
informedness,
false_negative_rate,
false_positive_rate) %>%
gather(variable, observed, c(balanced_accuracy,
informedness,
false_negative_rate,
false_positive_rate))# create bootstraps using out of bag method. makes a df with values that are collapsed dfs.
boots_subset <- data_classifications_subset %>%
bootstraps(times = 2000)
# apply to each bootstrap
fit_confirmatory_classification_bootstraps_subset <- boots_subset %>%
mutate(categorization_stats = future_map(splits, bootstrap_categorization_stats)) %>%
select(-splits) %>%
unnest(categorization_stats)classifications_subset <- fit_confirmatory_classification_bootstraps_subset %>%
gather(variable, value, c(balanced_accuracy,
informedness,
false_negative_rate,
false_positive_rate)) %>%
group_by(variable) %>%
summarize(ci_lower = quantile(value, 0.025),
ci_upper = quantile(value, 0.975),
.groups = "drop") %>%
full_join(fit_confirmatory_classification_subset, by = "variable") %>%
mutate_if(is.numeric, round, digits = 2) %>%
select(variable, observed, ci_lower, ci_upper)
classifications_subset %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| variable | observed | ci_lower | ci_upper |
|---|---|---|---|
| balanced_accuracy | 0.68 | 0.63 | 0.73 |
| false_negative_rate | 0.26 | 0.20 | 0.32 |
| false_positive_rate | 0.38 | 0.31 | 0.46 |
| informedness | 0.36 | 0.26 | 0.45 |
I.e., using the full sample and reporting the sample percentage.
Description of sample:
percent_aware <- data_after_exclusions %>%
dplyr::select(deepfake_awareness_closed) %>%
drop_na() %>%
count(deepfake_awareness_closed) %>%
mutate(counts = n,
awareness = as.factor(deepfake_awareness_closed),
percent_aware = round(counts/sum(counts)*100, 1)) %>%
filter(awareness == "aware") %>%
dplyr::select(percent_aware)
percent_aware %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| percent_aware |
|---|
| 56.3 |
Putting aside true negatives and false positive, does prior awareness of the concept of deepfaking at least make people better at detecting deepfakes
It would of course be possible include data from both experiment_conditions and add it to the model, however interpreting the two and three way interactions is less intuitive. Given this question is of secondary importance, I we therefore elected for the simpler analysis focusing on awareness and the FNR/TPR.
# convert data to counts
data_counts_awareness_detection <- data_after_exclusions %>%
filter(experiment_condition == "deepfaked") %>%
dplyr::select(experiment, deepfake_awareness_closed, deepfake_detection_closed) %>%
drop_na() %>%
mutate(deepfake_awareness_closed = case_when(deepfake_awareness_closed == "aware" ~ TRUE,
deepfake_awareness_closed == "unaware" ~ FALSE),
deepfake_detection_closed = case_when(deepfake_detection_closed == "deepfaked" ~ TRUE,
deepfake_detection_closed == "genuine" ~ FALSE)) %>%
count(experiment, deepfake_awareness_closed, deepfake_detection_closed) %>%
group_by(experiment) %>%
mutate(counts = n,
awareness = as.factor(deepfake_awareness_closed),
detection = as.factor(deepfake_detection_closed),
proportion = counts/sum(counts)) %>%
ungroup() %>%
dplyr::select(experiment, awareness, detection, counts, proportion)
# total counts is needed later to convert to proportions
total_counts_awareness_detection <- data_counts_awareness_detection %>%
group_by(experiment) %>%
summarize(total = sum(counts)) %>%
ungroup()
# fit poisson model
fit_confirmatory_poisson_awareness_detection <-
brm(formula = counts ~ 1 + awareness * detection,
family = poisson(),
data = data_counts_awareness_detection,
file = "models/fit_confirmatory_poisson_awareness_detection",
prior = prior(normal(0, 10)),
iter = 10000,
warmup = 3000,
control = list(adapt_delta = 0.998,
max_treedepth = 18), # to avoid divergent transitions
chains = 4,
cores = parallel::detectCores())## Family: poisson
## Links: mu = log
## Formula: counts ~ 1 + awareness * detection
## Data: data_counts_awareness_detection (Number of observations: 4)
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
## total post-warmup samples = 28000
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept 4.07 0.13 3.80 4.32 1.00 9626
## awarenessTRUE -0.16 0.19 -0.55 0.21 1.00 9916
## detectionTRUE 0.25 0.18 -0.09 0.60 1.00 9993
## awarenessTRUE:detectionTRUE 0.81 0.24 0.35 1.28 1.00 9030
## Tail_ESS
## Intercept 13622
## awarenessTRUE 12404
## detectionTRUE 13002
## awarenessTRUE:detectionTRUE 11006
##
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.
check_prior(fit_confirmatory_poisson_awareness_detection) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | Prior_Quality |
|---|---|
| b_Intercept | uninformative |
| b_awarenessTRUE | uninformative |
| b_detectionTRUE | uninformative |
| b_awarenessTRUE.detectionTRUE | uninformative |
sjPlot doesn’t behave well with these variable names for some reason. From top to bottom, the parameters are awareness, detection, and awareness*detection.
# posterior draws for parameters (for results table)
draws_awareness_detection <- posterior_samples(fit_confirmatory_poisson_awareness_detection) %>%
dplyr::select(awarenessTRUE = b_awarenessTRUE,
detectionTRUE = b_detectionTRUE,
interaction = `b_awarenessTRUE:detectionTRUE`)
estimates_awareness_detection <-
full_join(as_tibble(map_estimate(draws_awareness_detection)),
as_tibble(bayestestR::hdi(draws_awareness_detection, ci = .95)),
by = "Parameter") %>%
# exponentiate the log IRR values to IRR
mutate_if(is.numeric, exp) %>%
full_join(draws_awareness_detection %>%
gather(Parameter, value) %>%
group_by(Parameter) %>%
summarize(pd = mean(exp(value) > 1)) %>%
mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
ungroup() %>%
select(Parameter, p),
by = "Parameter") %>%
dplyr::select(Parameter, incidence_rate_ratio_MAP = MAP_Estimate, CI_95_lower = CI_low, CI_95_upper = CI_high, p)
# convert from odds to probability
# mutate_if(is.numeric, function(x){x/(1+x)}) %>%
# table
estimates_awareness_detection %>%
mutate_at(vars("incidence_rate_ratio_MAP", "CI_95_lower", "CI_95_upper"), round, digits = 2) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | incidence_rate_ratio_MAP | CI_95_lower | CI_95_upper | p |
|---|---|---|---|---|
| awarenessTRUE | 0.85 | 0.58 | 1.25 | 0.1956071 |
| detectionTRUE | 1.30 | 0.91 | 1.82 | 0.0718214 |
| interaction | 2.25 | 1.41 | 3.60 | 0.0000714 |
# hypothesis testing
H4 <- ifelse((estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(CI_95_lower)) > 1,
"Accepted", "Rejected")
comparison_string_awareness_detection <-
paste0("Individuals who were aware of the concept of Deepfakes prior to participating in the study were ",
estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(incidence_rate_ratio_MAP) %>% round(1),
" times more likely to detect that they had been shown a deepfake than those who were not aware of the concept (Incidence Rate Ratio = ",
estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(incidence_rate_ratio_MAP) %>% round(2),
", 95% CI [",
estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(CI_95_lower) %>% round(2),
", ",
estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(CI_95_upper) %>% round(2),
"])")H4
Using the subset of participants who were in the Deepfake condition, we calculated counts for each of the combinations of the Deepfake concept check and Deepfake detection questions (e.g., awareness = TRUE & detection = TRUE, awareness = TRUE & detection = FALSE, etc.). We will then use a Bayesian Poisson model to estimate a 95% Credible Interval around the interaction effect’s Incidence Rate Ratio. A Credible Interval whose lower bound is > 1 will be considered evidence in support of this hypothesis. Estimated marginal predicted probabilities will also be reported.
posterior_predictions_awareness_detection <-
tibble(experiment = 7,
awareness = c("TRUE", "FALSE"),
detection = c("TRUE", "FALSE")) %>%
data_grid(experiment, awareness, detection) %>%
add_predicted_draws(model = fit_confirmatory_poisson_awareness_detection, re_formula = NULL) %>%
rename(predicted_count = .prediction) %>%
left_join(total_counts_awareness_detection, by = "experiment") %>%
mutate(predicted_probabiity = predicted_count/total) %>%
ungroup() %>%
dplyr::select(awareness, detection, predicted_count, predicted_probabiity)
posterior_predictions_awareness_detection_aT_dT <- posterior_predictions_awareness_detection %>%
filter(awareness == "TRUE" & detection == "TRUE")
posterior_predictions_awareness_detection_aT_dF <- posterior_predictions_awareness_detection %>%
filter(awareness == "TRUE" & detection == "FALSE")
posterior_predictions_awareness_detection_aF_dT <- posterior_predictions_awareness_detection %>%
filter(awareness == "FALSE" & detection == "TRUE")
posterior_predictions_awareness_detection_aF_dF <- posterior_predictions_awareness_detection %>%
filter(awareness == "FALSE" & detection == "FALSE")
results_detection_probabilities <-
rbind(
bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aT_dT$predicted_probabiity)),
as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aT_dT$predicted_probabiity,
ci = .95))) %>%
mutate(awareness = "TRUE", detection = "TRUE"),
bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aT_dF$predicted_probabiity)),
as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aT_dF$predicted_probabiity,
ci = .95))) %>%
mutate(awareness = "TRUE", detection = "FALSE"),
bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aF_dT$predicted_probabiity)),
as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aF_dT$predicted_probabiity,
ci = .95))) %>%
mutate(awareness = "FALSE", detection = "TRUE"),
bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aF_dF$predicted_probabiity)),
as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aF_dF$predicted_probabiity,
ci = .95))) %>%
mutate(awareness = "FALSE", detection = "FALSE")
) %>%
dplyr::select(awareness, detection, detection_probability_MAP = value,
CI_95_lower = CI_low, CI_95_upper = CI_high) %>%
mutate_if(is.numeric, round, digits = 3)
results_detection_probabilities %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| awareness | detection | detection_probability_MAP | CI_95_lower | CI_95_upper |
|---|---|---|---|---|
| TRUE | TRUE | 0.437 | 0.345 | 0.545 |
| TRUE | FALSE | 0.152 | 0.100 | 0.218 |
| FALSE | TRUE | 0.225 | 0.161 | 0.306 |
| FALSE | FALSE | 0.176 | 0.121 | 0.248 |
Subset who received deepfaked videos and were aware of the concept prior to the experiment. Same Bayesian multilevel models as employed above, using only source_valence as IV, i.e., to detect whether learning effects are credibly non-zero in this subset.
data_aware_subset_n <- data_after_exclusions %>%
filter(experiment_condition == "deepfaked" & deepfake_awareness_closed == "aware") %>%
count(deepfake_awareness_closed) %>%
mutate(proportion = round(n/sum(n), 2)) %>%
arrange(desc(proportion))
data_aware_subset_n %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| deepfake_awareness_closed | n | proportion |
|---|---|---|
| aware | 195 | 1 |
fit_confirmatory_selfreport_deepfaked_aware <-
brm(formula = mean_self_reported_evaluation ~ source_valence,
family = gaussian(),
data = data_aware_subset,
file = "models/fit_confirmatory_selfreport_deepfaked_aware",
prior = prior(normal(0, 10)),
iter = 10000,
warmup = 3000,
control = list(adapt_delta = 0.99), # to avoid divergent transitions
chains = 4,
cores = parallel::detectCores())## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: mean_self_reported_evaluation ~ source_valence
## Data: data_aware_subset (Number of observations: 195)
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
## total post-warmup samples = 28000
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -1.25 0.11 -1.47 -1.04 1.00 21154
## source_valencepositive 2.11 0.15 1.82 2.41 1.00 21665
## Tail_ESS
## Intercept 17317
## source_valencepositive 16631
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 1.04 0.05 0.94 1.15 1.00 22712 18843
##
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.
check_prior(fit_confirmatory_selfreport_deepfaked_aware) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | Prior_Quality |
|---|---|
| b_Intercept | uninformative |
| b_source_valencepositive | uninformative |
#plot_model(fit_confirmatory_selfreport_deepfaked_aware)
plot_model(fit_confirmatory_selfreport_deepfaked_aware, type = "pred", terms = "source_valence")# results table
draws_sr_deepfaked_aware <-
select(spread_draws(fit_confirmatory_selfreport_deepfaked_aware, b_source_valencepositive), b_source_valencepositive) %>%
rename(effect_deepfaked_aware = b_source_valencepositive)
estimates_sr_deepfaked_aware <-
map_estimate(draws_sr_deepfaked_aware) %>%
full_join(bayestestR::hdi(draws_sr_deepfaked_aware, ci = .95) %>%
rename(CI_95_lower = CI_low,
CI_95_upper = CI_high) %>%
as_tibble(),
by = "Parameter") %>%
full_join(bayestestR::hdi(draws_sr_deepfaked_aware, ci = .90) %>%
as_tibble() %>%
rename(CI_90_lower = CI_low,
CI_90_upper = CI_high),
by = "Parameter") %>%
full_join(draws_sr_deepfaked_aware %>%
gather(Parameter, value) %>%
group_by(Parameter) %>%
summarize(pd = mean(value > 0)) %>%
mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
ungroup() %>%
select(Parameter, p),
by = "Parameter") %>%
select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
CI_90_lower, CI_90_upper, p)
bind_rows(filter(estimates_sr, Parameter %in% c("effect_deepfaked")),
estimates_sr_deepfaked_aware) %>%
mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | MAP_Estimate | CI_95_lower | CI_95_upper | CI_90_lower | CI_90_upper | p |
|---|---|---|---|---|---|---|
| effect_deepfaked | 2.35 | 2.15 | 2.59 | 2.18 | 2.55 | 0 |
| effect_deepfaked_aware | 2.10 | 1.83 | 2.41 | 1.87 | 2.35 | 0 |
# hypothesis testing
H5a <- ifelse((estimates_sr_deepfaked_aware %>% filter(Parameter == "effect_deepfaked_aware") %>%
pull(CI_95_lower)) > 0,
"Accepted", "Rejected")H5a
In the subset of participants who were shown a Deepfaked video and reported being aware of the concept of Deepfaking prior to participating in the experiment, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ self-reported evaluations.
fit_confirmatory_implicit_deepfaked_aware <-
brm(formula = IAT_D2 ~ source_valence,
family = gaussian(),
data = data_aware_subset,
file = "models/fit_confirmatory_implicit_deepfaked_aware",
prior = prior(normal(0, 10)),
iter = 10000,
warmup = 3000,
control = list(adapt_delta = 0.99), # to avoid divergent transitions
chains = 4,
cores = parallel::detectCores())## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: IAT_D2 ~ source_valence
## Data: data_aware_subset (Number of observations: 195)
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
## total post-warmup samples = 28000
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept 0.18 0.10 -0.03 0.38 1.00 19749
## source_valencepositive 1.31 0.14 1.03 1.59 1.00 19653
## Tail_ESS
## Intercept 17254
## source_valencepositive 17016
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 1.01 0.05 0.91 1.11 1.00 19904 15183
##
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.
check_prior(fit_confirmatory_implicit_deepfaked_aware) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | Prior_Quality |
|---|---|
| b_Intercept | uninformative |
| b_source_valencepositive | uninformative |
#plot_model(fit_confirmatory_implicit_deepfaked_aware)
plot_model(fit_confirmatory_implicit_deepfaked_aware, type = "pred", terms = "source_valence")# results table
draws_imp_deepfaked_aware <-
select(spread_draws(fit_confirmatory_implicit_deepfaked_aware, b_source_valencepositive), b_source_valencepositive) %>%
rename(effect_deepfaked_aware = b_source_valencepositive)
estimates_imp_deepfaked_aware <-
map_estimate(draws_imp_deepfaked_aware) %>%
full_join(bayestestR::hdi(draws_imp_deepfaked_aware, ci = .95) %>%
rename(CI_95_lower = CI_low,
CI_95_upper = CI_high) %>%
as_tibble(),
by = "Parameter") %>%
full_join(bayestestR::hdi(draws_imp_deepfaked_aware, ci = .90) %>%
as_tibble() %>%
rename(CI_90_lower = CI_low,
CI_90_upper = CI_high),
by = "Parameter") %>%
full_join(draws_imp_deepfaked_aware %>%
gather(Parameter, value) %>%
group_by(Parameter) %>%
summarize(pd = mean(value > 0)) %>%
mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
ungroup() %>%
select(Parameter, p),
by = "Parameter") %>%
select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
CI_90_lower, CI_90_upper, p)
bind_rows(filter(estimates_imp, Parameter %in% c("effect_deepfaked")),
estimates_imp_deepfaked_aware) %>%
mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | MAP_Estimate | CI_95_lower | CI_95_upper | CI_90_lower | CI_90_upper | p |
|---|---|---|---|---|---|---|
| effect_deepfaked | 1.36 | 1.14 | 1.57 | 1.17 | 1.53 | 0 |
| effect_deepfaked_aware | 1.29 | 1.03 | 1.59 | 1.07 | 1.54 | 0 |
# hypothesis testing
H5b <- ifelse((estimates_imp_deepfaked_aware %>% filter(Parameter == "effect_deepfaked_aware") %>%
pull(CI_95_lower)) > 0,
"Accepted", "Rejected")H5b
In the subset of participants who were shown a Deepfaked video and reported being aware of the concept of Deepfaking prior to participating in the experiment, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ IAT D2 scores.
fit_confirmatory_intentions_deepfaked_aware <-
brm(formula = mean_intentions ~ source_valence,
family = gaussian(),
data = data_aware_subset,
file = "models/fit_confirmatory_intentions_deepfaked_aware",
prior = prior(normal(0, 10)),
iter = 10000,
warmup = 3000,
control = list(adapt_delta = 0.99), # to avoid divergent transitions
chains = 4,
cores = parallel::detectCores())## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: mean_intentions ~ source_valence
## Data: data_aware_subset (Number of observations: 195)
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
## total post-warmup samples = 28000
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -5.18 0.11 -5.39 -4.97 1.00 22696
## source_valencepositive 2.50 0.15 2.20 2.79 1.00 23498
## Tail_ESS
## Intercept 17280
## source_valencepositive 17370
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 1.04 0.05 0.94 1.15 1.00 23062 18671
##
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.
check_prior(fit_confirmatory_intentions_deepfaked_aware) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | Prior_Quality |
|---|---|
| b_Intercept | uninformative |
| b_source_valencepositive | uninformative |
#plot_model(fit_confirmatory_intentions_deepfaked_aware)
plot_model(fit_confirmatory_intentions_deepfaked_aware, type = "pred", terms = "source_valence")# results table
draws_intentions_deepfaked_aware <-
select(spread_draws(fit_confirmatory_intentions_deepfaked_aware, b_source_valencepositive), b_source_valencepositive) %>%
rename(effect_deepfaked_aware = b_source_valencepositive)
estimates_intentions_deepfaked_aware <-
map_estimate(draws_intentions_deepfaked_aware) %>%
full_join(bayestestR::hdi(draws_intentions_deepfaked_aware, ci = .95) %>%
rename(CI_95_lower = CI_low,
CI_95_upper = CI_high) %>%
as_tibble(),
by = "Parameter") %>%
full_join(bayestestR::hdi(draws_intentions_deepfaked_aware, ci = .90) %>%
as_tibble() %>%
rename(CI_90_lower = CI_low,
CI_90_upper = CI_high),
by = "Parameter") %>%
full_join(draws_intentions_deepfaked_aware %>%
gather(Parameter, value) %>%
group_by(Parameter) %>%
summarize(pd = mean(value > 0)) %>%
mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
ungroup() %>%
select(Parameter, p),
by = "Parameter") %>%
select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
CI_90_lower, CI_90_upper, p)
bind_rows(filter(estimates_intentions, Parameter %in% c("effect_deepfaked")),
estimates_intentions_deepfaked_aware) %>%
mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | MAP_Estimate | CI_95_lower | CI_95_upper | CI_90_lower | CI_90_upper | p |
|---|---|---|---|---|---|---|
| effect_deepfaked | 2.68 | 2.47 | 2.90 | 2.51 | 2.87 | 0 |
| effect_deepfaked_aware | 2.50 | 2.21 | 2.81 | 2.25 | 2.75 | 0 |
# hypothesis testing
H5c <- ifelse((estimates_intentions_deepfaked_aware %>% filter(Parameter == "effect_deepfaked_aware") %>%
pull(CI_95_lower)) > 0,
"Accepted", "Rejected")H5c
In the subset of participants who were shown a Deepfaked video and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ behavioral intention scores.
Subset who received deepfaked videos but also detected them. Same Bayesian multilevel models as employed above, using only source_valence as IV, i.e., to detect whether learning effects are credibly non-zero in this subset.
data_detectors_subset_n <- data_after_exclusions %>%
filter(experiment_condition == "deepfaked" & deepfake_detection_closed == "deepfaked") %>%
count(deepfake_detection_closed) %>%
mutate(proportion = round(n/sum(n), 2)) %>%
arrange(desc(proportion))
data_detectors_subset_n %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| deepfake_detection_closed | n | proportion |
|---|---|---|
| deepfaked | 221 | 1 |
fit_confirmatory_selfreport_deepfaked_detected <-
brm(formula = mean_self_reported_evaluation ~ source_valence,
family = gaussian(),
data = data_detectors_subset,
file = "models/fit_confirmatory_selfreport_deepfaked_detected",
prior = prior(normal(0, 10)),
iter = 10000,
warmup = 3000,
control = list(adapt_delta = 0.99), # to avoid divergent transitions
chains = 4,
cores = parallel::detectCores())## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: mean_self_reported_evaluation ~ source_valence
## Data: data_detectors_subset (Number of observations: 221)
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
## total post-warmup samples = 28000
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -1.40 0.09 -1.58 -1.22 1.00 22079
## source_valencepositive 2.19 0.13 1.93 2.45 1.00 22346
## Tail_ESS
## Intercept 17644
## source_valencepositive 17333
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 0.98 0.05 0.89 1.08 1.00 21146 17368
##
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.
check_prior(fit_confirmatory_selfreport_deepfaked_detected) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | Prior_Quality |
|---|---|
| b_Intercept | uninformative |
| b_source_valencepositive | uninformative |
#plot_model(fit_confirmatory_selfreport_deepfaked_detected)
plot_model(fit_confirmatory_selfreport_deepfaked_detected, type = "pred", terms = "source_valence")# results table
draws_sr_deepfaked_detected <-
select(spread_draws(fit_confirmatory_selfreport_deepfaked_detected, b_source_valencepositive), b_source_valencepositive) %>%
rename(effect_deepfaked_detected = b_source_valencepositive)
estimates_sr_deepfaked_detected <-
map_estimate(draws_sr_deepfaked_detected) %>%
full_join(bayestestR::hdi(draws_sr_deepfaked_detected, ci = .95) %>%
rename(CI_95_lower = CI_low,
CI_95_upper = CI_high) %>%
as_tibble(),
by = "Parameter") %>%
full_join(bayestestR::hdi(draws_sr_deepfaked_detected, ci = .90) %>%
as_tibble() %>%
rename(CI_90_lower = CI_low,
CI_90_upper = CI_high),
by = "Parameter") %>%
full_join(draws_sr_deepfaked_detected %>%
gather(Parameter, value) %>%
group_by(Parameter) %>%
summarize(pd = mean(value > 0)) %>%
mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
ungroup() %>%
select(Parameter, p),
by = "Parameter") %>%
select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
CI_90_lower, CI_90_upper, p)
bind_rows(filter(estimates_sr, Parameter %in% c("effect_deepfaked")),
estimates_sr_deepfaked_detected) %>%
mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | MAP_Estimate | CI_95_lower | CI_95_upper | CI_90_lower | CI_90_upper | p |
|---|---|---|---|---|---|---|
| effect_deepfaked | 2.35 | 2.15 | 2.59 | 2.18 | 2.55 | 0 |
| effect_deepfaked_detected | 2.18 | 1.93 | 2.44 | 1.97 | 2.40 | 0 |
# hypothesis testing
H6a <- ifelse((estimates_sr_deepfaked_detected %>% filter(Parameter == "effect_deepfaked_detected") %>%
pull(CI_95_lower)) > 0,
"Accepted", "Rejected")H6a
In the subset of participants who were shown a Deepfaked video and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ self-reported evaluations.
fit_confirmatory_implicit_deepfaked_detected <-
brm(formula = IAT_D2 ~ source_valence,
family = gaussian(),
data = data_detectors_subset,
file = "models/fit_confirmatory_implicit_deepfaked_detected",
prior = prior(normal(0, 10)),
iter = 10000,
warmup = 3000,
control = list(adapt_delta = 0.99), # to avoid divergent transitions
chains = 4,
cores = parallel::detectCores())## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: IAT_D2 ~ source_valence
## Data: data_detectors_subset (Number of observations: 221)
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
## total post-warmup samples = 28000
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept 0.13 0.09 -0.05 0.31 1.00 22733
## source_valencepositive 1.37 0.13 1.11 1.63 1.00 23423
## Tail_ESS
## Intercept 16550
## source_valencepositive 17109
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 0.99 0.05 0.90 1.08 1.00 23608 18072
##
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.
check_prior(fit_confirmatory_implicit_deepfaked_detected) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | Prior_Quality |
|---|---|
| b_Intercept | uninformative |
| b_source_valencepositive | uninformative |
#plot_model(fit_confirmatory_implicit_deepfaked_detected)
plot_model(fit_confirmatory_implicit_deepfaked_detected, type = "pred", terms = "source_valence")# results table
draws_imp_deepfaked_detected <-
select(spread_draws(fit_confirmatory_implicit_deepfaked_detected, b_source_valencepositive), b_source_valencepositive) %>%
rename(effect_deepfaked_detected = b_source_valencepositive)
estimates_imp_deepfaked_detected <-
map_estimate(draws_imp_deepfaked_detected) %>%
full_join(bayestestR::hdi(draws_imp_deepfaked_detected, ci = .95) %>%
rename(CI_95_lower = CI_low,
CI_95_upper = CI_high) %>%
as_tibble(),
by = "Parameter") %>%
full_join(bayestestR::hdi(draws_imp_deepfaked_detected, ci = .90) %>%
as_tibble() %>%
rename(CI_90_lower = CI_low,
CI_90_upper = CI_high),
by = "Parameter") %>%
full_join(draws_imp_deepfaked_detected %>%
gather(Parameter, value) %>%
group_by(Parameter) %>%
summarize(pd = mean(value > 0)) %>%
mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
ungroup() %>%
select(Parameter, p),
by = "Parameter") %>%
select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
CI_90_lower, CI_90_upper, p)
bind_rows(filter(estimates_imp, Parameter %in% c("effect_deepfaked")),
estimates_imp_deepfaked_detected) %>%
mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | MAP_Estimate | CI_95_lower | CI_95_upper | CI_90_lower | CI_90_upper | p |
|---|---|---|---|---|---|---|
| effect_deepfaked | 1.36 | 1.14 | 1.57 | 1.17 | 1.53 | 0 |
| effect_deepfaked_detected | 1.37 | 1.12 | 1.64 | 1.15 | 1.59 | 0 |
# hypothesis testing
H6b <- ifelse((estimates_imp_deepfaked_detected %>% filter(Parameter == "effect_deepfaked_detected") %>%
pull(CI_95_lower)) > 0,
"Accepted", "Rejected")H6b
In the subset of participants who were shown a Deepfaked video and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ IAT D2 scores.
fit_confirmatory_intentions_deepfaked_detected <-
brm(formula = mean_intentions ~ source_valence, # no random effect for experiment as only exp 6 assessed intentions
family = gaussian(),
data = data_detectors_subset,
file = "models/fit_confirmatory_intentions_deepfaked_detected",
prior = prior(normal(0, 10)),
iter = 10000,
warmup = 3000,
control = list(adapt_delta = 0.99), # to avoid divergent transitions
chains = 4,
cores = parallel::detectCores())## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: mean_intentions ~ source_valence
## Data: data_detectors_subset (Number of observations: 221)
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
## total post-warmup samples = 28000
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -5.30 0.09 -5.48 -5.13 1.00 20692
## source_valencepositive 2.58 0.13 2.33 2.83 1.00 21135
## Tail_ESS
## Intercept 16877
## source_valencepositive 16779
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 0.96 0.05 0.87 1.05 1.00 21421 17374
##
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.
check_prior(fit_confirmatory_intentions_deepfaked_detected) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | Prior_Quality |
|---|---|
| b_Intercept | uninformative |
| b_source_valencepositive | uninformative |
#plot_model(fit_confirmatory_intentions_deepfaked_detected)
plot_model(fit_confirmatory_intentions_deepfaked_detected, type = "pred", terms = "source_valence")# results table
draws_intentions_deepfaked_detected <-
select(spread_draws(fit_confirmatory_intentions_deepfaked_detected, b_source_valencepositive), b_source_valencepositive) %>%
rename(effect_deepfaked_detected = b_source_valencepositive)
estimates_intentions_deepfaked_detected <-
map_estimate(draws_intentions_deepfaked_detected) %>%
full_join(bayestestR::hdi(draws_intentions_deepfaked_detected, ci = .95) %>%
rename(CI_95_lower = CI_low,
CI_95_upper = CI_high) %>%
as_tibble(),
by = "Parameter") %>%
full_join(bayestestR::hdi(draws_intentions_deepfaked_detected, ci = .90) %>%
as_tibble() %>%
rename(CI_90_lower = CI_low,
CI_90_upper = CI_high),
by = "Parameter") %>%
full_join(draws_intentions_deepfaked_detected %>%
gather(Parameter, value) %>%
group_by(Parameter) %>%
summarize(pd = mean(value > 0)) %>%
mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
ungroup() %>%
select(Parameter, p),
by = "Parameter") %>%
select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
CI_90_lower, CI_90_upper, p)
bind_rows(filter(estimates_intentions, Parameter %in% c("effect_deepfaked")),
estimates_intentions_deepfaked_detected) %>%
mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | MAP_Estimate | CI_95_lower | CI_95_upper | CI_90_lower | CI_90_upper | p |
|---|---|---|---|---|---|---|
| effect_deepfaked | 2.68 | 2.47 | 2.90 | 2.51 | 2.87 | 0 |
| effect_deepfaked_detected | 2.57 | 2.33 | 2.83 | 2.37 | 2.79 | 0 |
# hypothesis testing
H6c <- ifelse((estimates_intentions_deepfaked_detected %>% filter(Parameter == "effect_deepfaked_detected") %>%
pull(CI_95_lower)) > 0,
"Accepted", "Rejected")H6c
In the subset of participants who were shown a Deepfaked video and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ behavioral intention scores.
Subset who received deepfaked videos, were aware of the concept before the study, and also detected them. Same Bayesian multilevel models as employed above, using only source_valence as IV, i.e., to detect whether learning effects are credibly non-zero in this subset.
data_aware_detectors_subset_n <- data_after_exclusions %>%
filter(experiment_condition == "deepfaked" &
deepfake_detection_closed == "deepfaked" &
deepfake_awareness_closed == "aware") %>%
count(deepfake_detection_closed, deepfake_awareness_closed) %>%
mutate(proportion = round(n/sum(n), 2)) %>%
arrange(desc(proportion))
data_aware_detectors_subset_n %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| deepfake_detection_closed | deepfake_awareness_closed | n | proportion |
|---|---|---|---|
| deepfaked | aware | 145 | 1 |
fit_confirmatory_selfreport_deepfaked_aware_detected <-
brm(formula = mean_self_reported_evaluation ~ source_valence,
family = gaussian(),
data = data_aware_detectors_subset,
file = "models/fit_confirmatory_selfreport_deepfaked_aware_detected",
prior = prior(normal(0, 10)),
iter = 10000,
warmup = 3000,
control = list(adapt_delta = 0.99), # to avoid divergent transitions
chains = 4,
cores = parallel::detectCores())## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: mean_self_reported_evaluation ~ source_valence
## Data: data_aware_detectors_subset (Number of observations: 145)
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
## total post-warmup samples = 28000
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -1.28 0.11 -1.50 -1.06 1.00 22539
## source_valencepositive 1.96 0.16 1.66 2.28 1.00 22518
## Tail_ESS
## Intercept 16995
## source_valencepositive 17282
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 0.96 0.06 0.85 1.08 1.00 20758 16413
##
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.
check_prior(fit_confirmatory_selfreport_deepfaked_aware_detected) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | Prior_Quality |
|---|---|
| b_Intercept | uninformative |
| b_source_valencepositive | uninformative |
#plot_model(fit_confirmatory_selfreport_deepfaked_aware_detected)
plot_model(fit_confirmatory_selfreport_deepfaked_aware_detected, type = "pred", terms = "source_valence")# results table
draws_sr_deepfaked_aware_detected <-
select(spread_draws(fit_confirmatory_selfreport_deepfaked_aware_detected, b_source_valencepositive), b_source_valencepositive) %>%
rename(effect_deepfaked_aware_detected = b_source_valencepositive)
estimates_sr_deepfaked_aware_detected <-
map_estimate(draws_sr_deepfaked_aware_detected) %>%
full_join(bayestestR::hdi(draws_sr_deepfaked_aware_detected, ci = .95) %>%
rename(CI_95_lower = CI_low,
CI_95_upper = CI_high) %>%
as_tibble(),
by = "Parameter") %>%
full_join(bayestestR::hdi(draws_sr_deepfaked_aware_detected, ci = .90) %>%
as_tibble() %>%
rename(CI_90_lower = CI_low,
CI_90_upper = CI_high),
by = "Parameter") %>%
full_join(draws_sr_deepfaked_aware_detected %>%
gather(Parameter, value) %>%
group_by(Parameter) %>%
summarize(pd = mean(value > 0)) %>%
mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
ungroup() %>%
select(Parameter, p),
by = "Parameter") %>%
select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
CI_90_lower, CI_90_upper, p)
bind_rows(filter(estimates_sr, Parameter %in% c("effect_deepfaked")),
estimates_sr_deepfaked_aware_detected) %>%
mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | MAP_Estimate | CI_95_lower | CI_95_upper | CI_90_lower | CI_90_upper | p |
|---|---|---|---|---|---|---|
| effect_deepfaked | 2.35 | 2.15 | 2.59 | 2.18 | 2.55 | 0 |
| effect_deepfaked_aware_detected | 1.98 | 1.65 | 2.27 | 1.70 | 2.21 | 0 |
# hypothesis testing
H7a <- ifelse((estimates_sr_deepfaked_aware_detected %>% filter(Parameter == "effect_deepfaked_aware_detected") %>%
pull(CI_95_lower)) > 0,
"Accepted", "Rejected")H7a
In the subset of participants who were shown a Deepfaked video, reported being aware of the concept of Deepfakes, and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ self-reported evaluations.
fit_confirmatory_implicit_deepfaked_aware_detected <-
brm(formula = IAT_D2 ~ source_valence,
family = gaussian(),
data = data_aware_detectors_subset,
file = "models/fit_confirmatory_implicit_deepfaked_aware_detected",
prior = prior(normal(0, 10)),
iter = 10000,
warmup = 3000,
control = list(adapt_delta = 0.99), # to avoid divergent transitions
chains = 4,
cores = parallel::detectCores())## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: IAT_D2 ~ source_valence
## Data: data_aware_detectors_subset (Number of observations: 145)
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
## total post-warmup samples = 28000
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept 0.18 0.12 -0.05 0.41 1.00 20967
## source_valencepositive 1.33 0.16 1.00 1.65 1.00 21336
## Tail_ESS
## Intercept 16811
## source_valencepositive 17624
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 0.99 0.06 0.88 1.12 1.00 20438 16754
##
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.
check_prior(fit_confirmatory_implicit_deepfaked_aware_detected) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | Prior_Quality |
|---|---|
| b_Intercept | uninformative |
| b_source_valencepositive | uninformative |
#plot_model(fit_confirmatory_implicit_deepfaked_aware_detected)
plot_model(fit_confirmatory_implicit_deepfaked_aware_detected, type = "pred", terms = "source_valence")# results table
draws_imp_deepfaked_aware_detected <-
select(spread_draws(fit_confirmatory_implicit_deepfaked_aware_detected, b_source_valencepositive), b_source_valencepositive) %>%
rename(effect_deepfaked_aware_detected = b_source_valencepositive)
estimates_imp_deepfaked_aware_detected <-
map_estimate(draws_imp_deepfaked_aware_detected) %>%
full_join(bayestestR::hdi(draws_imp_deepfaked_aware_detected, ci = .95) %>%
rename(CI_95_lower = CI_low,
CI_95_upper = CI_high) %>%
as_tibble(),
by = "Parameter") %>%
full_join(bayestestR::hdi(draws_imp_deepfaked_aware_detected, ci = .90) %>%
as_tibble() %>%
rename(CI_90_lower = CI_low,
CI_90_upper = CI_high),
by = "Parameter") %>%
full_join(draws_imp_deepfaked_aware_detected %>%
gather(Parameter, value) %>%
group_by(Parameter) %>%
summarize(pd = mean(value > 0)) %>%
mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
ungroup() %>%
select(Parameter, p),
by = "Parameter") %>%
select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
CI_90_lower, CI_90_upper, p)
bind_rows(filter(estimates_imp, Parameter %in% c("effect_deepfaked")),
estimates_imp_deepfaked_aware_detected) %>%
mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | MAP_Estimate | CI_95_lower | CI_95_upper | CI_90_lower | CI_90_upper | p |
|---|---|---|---|---|---|---|
| effect_deepfaked | 1.36 | 1.14 | 1.57 | 1.17 | 1.53 | 0 |
| effect_deepfaked_aware_detected | 1.35 | 1.01 | 1.65 | 1.06 | 1.60 | 0 |
# hypothesis testing
H7b <- ifelse((estimates_imp_deepfaked_aware_detected %>% filter(Parameter == "effect_deepfaked_aware_detected") %>%
pull(CI_95_lower)) > 0,
"Accepted", "Rejected")H7b
In the subset of participants who were shown a Deepfaked video, reported being aware of the concept of Deepfakes, and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ IAT D2 scores.
fit_confirmatory_intentions_deepfaked_aware_detected <-
brm(formula = mean_intentions ~ source_valence, # no random effect for experiment as only exp 6 assessed intentions
family = gaussian(),
data = data_aware_detectors_subset,
file = "models/fit_confirmatory_intentions_deepfaked_aware_detected",
prior = prior(normal(0, 10)),
iter = 10000,
warmup = 3000,
control = list(adapt_delta = 0.99), # to avoid divergent transitions
chains = 4,
cores = parallel::detectCores())## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: mean_intentions ~ source_valence
## Data: data_aware_detectors_subset (Number of observations: 145)
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
## total post-warmup samples = 28000
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -5.23 0.11 -5.45 -5.00 1.00 21238
## source_valencepositive 2.38 0.16 2.07 2.70 1.00 19802
## Tail_ESS
## Intercept 17340
## source_valencepositive 17057
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 0.97 0.06 0.86 1.09 1.00 20368 16850
##
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.
check_prior(fit_confirmatory_intentions_deepfaked_aware_detected) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | Prior_Quality |
|---|---|
| b_Intercept | uninformative |
| b_source_valencepositive | uninformative |
#plot_model(fit_confirmatory_intentions_deepfaked_aware_detected)
plot_model(fit_confirmatory_intentions_deepfaked_aware_detected, type = "pred", terms = "source_valence")# results table
draws_intentions_deepfaked_aware_detected <-
select(spread_draws(fit_confirmatory_intentions_deepfaked_aware_detected, b_source_valencepositive), b_source_valencepositive) %>%
rename(effect_deepfaked_aware_detected = b_source_valencepositive)
estimates_intentions_deepfaked_aware_detected <-
map_estimate(draws_intentions_deepfaked_aware_detected) %>%
full_join(bayestestR::hdi(draws_intentions_deepfaked_aware_detected, ci = .95) %>%
rename(CI_95_lower = CI_low,
CI_95_upper = CI_high) %>%
as_tibble(),
by = "Parameter") %>%
full_join(bayestestR::hdi(draws_intentions_deepfaked_aware_detected, ci = .90) %>%
as_tibble() %>%
rename(CI_90_lower = CI_low,
CI_90_upper = CI_high),
by = "Parameter") %>%
full_join(draws_intentions_deepfaked_aware_detected %>%
gather(Parameter, value) %>%
group_by(Parameter) %>%
summarize(pd = mean(value > 0)) %>%
mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
ungroup() %>%
select(Parameter, p),
by = "Parameter") %>%
select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
CI_90_lower, CI_90_upper, p)
bind_rows(filter(estimates_intentions, Parameter %in% c("effect_deepfaked")),
estimates_intentions_deepfaked_aware_detected) %>%
mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Parameter | MAP_Estimate | CI_95_lower | CI_95_upper | CI_90_lower | CI_90_upper | p |
|---|---|---|---|---|---|---|
| effect_deepfaked | 2.68 | 2.47 | 2.9 | 2.51 | 2.87 | 0 |
| effect_deepfaked_aware_detected | 2.39 | 2.07 | 2.7 | 2.12 | 2.65 | 0 |
# hypothesis testing
H7c <- ifelse((estimates_intentions_deepfaked_aware_detected %>% filter(Parameter == "effect_deepfaked_aware_detected") %>%
pull(CI_95_lower)) > 0,
"Accepted", "Rejected")H7c
In the subset of participants who were shown a Deepfaked video, reported being aware of the concept of Deepfakes, and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ behavioral intention scores.
H1: Establishing first impressions via online video content
H2: Are deepfakes just as good as the real thing?
H3: How good are people at detecting whether content is genuine or Deepfaked?
Whole sample
classifications %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| variable | observed | ci_lower | ci_upper |
|---|---|---|---|
| balanced_accuracy | 0.64 | 0.60 | 0.67 |
| false_negative_rate | 0.33 | 0.28 | 0.38 |
| false_positive_rate | 0.39 | 0.34 | 0.45 |
| informedness | 0.27 | 0.20 | 0.35 |
Those who were aware of the concept prior to the study
classifications_subset %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| variable | observed | ci_lower | ci_upper |
|---|---|---|---|
| balanced_accuracy | 0.68 | 0.63 | 0.73 |
| false_negative_rate | 0.26 | 0.20 | 0.32 |
| false_positive_rate | 0.38 | 0.31 | 0.46 |
| informedness | 0.36 | 0.26 | 0.45 |
H4: Does prior awareness of the concept of Deepfakes make people better at detecting them?
H5-7: Does being aware of the concept, detecitng the deepfake, or both make you immune to a Deepfake?
## R version 4.0.2 (2020-06-22)
## Platform: x86_64-apple-darwin17.0 (64-bit)
## Running under: macOS 10.16
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRblas.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib
##
## locale:
## [1] en_IE.UTF-8/en_IE.UTF-8/en_IE.UTF-8/C/en_IE.UTF-8/en_IE.UTF-8
##
## attached base packages:
## [1] parallel stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] e1071_1.7-3 caret_6.0-86 lattice_0.20-41 furrr_0.2.1
## [5] future_1.19.1 modelr_0.1.8 semTools_0.5-3 lavaan_0.6-7
## [9] IATscores_0.2.7 broom_0.7.2 rsample_0.0.7 psych_2.0.9
## [13] sjPlot_2.8.4 bayestestR_0.7.5 tidybayes_2.0.3 brms_2.14.0
## [17] Rcpp_1.0.5 kableExtra_1.3.1 knitr_1.30 forcats_0.5.0
## [21] stringr_1.4.0 dplyr_1.0.2 purrr_0.3.4 readr_1.3.1
## [25] tidyr_1.1.2 tibble_3.0.4 ggplot2_3.3.2 tidyverse_1.3.0
##
## loaded via a namespace (and not attached):
## [1] tidyselect_1.1.0 lme4_1.1-25 htmlwidgets_1.5.1
## [4] grid_4.0.2 pROC_1.16.2 munsell_0.5.0
## [7] codetools_0.2-16 effectsize_0.4.0 statmod_1.4.34
## [10] DT_0.13 miniUI_0.1.1.1 withr_2.3.0
## [13] Brobdingnag_1.2-6 colorspace_2.0-0 highr_0.8
## [16] rstudioapi_0.13 stats4_4.0.2 bayesplot_1.7.2
## [19] listenv_0.8.0 labeling_0.4.2 huge_1.3.4.1
## [22] emmeans_1.4.6 rstan_2.21.2 mnormt_1.5-7
## [25] farver_2.0.3 bridgesampling_1.0-0 coda_0.19-3
## [28] vctrs_0.3.5 generics_0.0.2 TH.data_1.0-10
## [31] ipred_0.9-9 xfun_0.19 R6_2.5.0
## [34] markdown_1.1 assertthat_0.2.1 promises_1.1.0
## [37] scales_1.1.1 multcomp_1.4-13 nnet_7.3-14
## [40] gtable_0.3.0 globals_0.13.1 processx_3.4.4
## [43] sandwich_2.5-1 timeDate_3043.102 rlang_0.4.8
## [46] splines_4.0.2 ModelMetrics_1.2.2.2 checkmate_2.0.0
## [49] inline_0.3.16 yaml_2.2.1 reshape2_1.4.4
## [52] abind_1.4-5 d3Network_0.5.2.1 threejs_0.3.3
## [55] crosstalk_1.1.0.1 backports_1.1.9 httpuv_1.5.2
## [58] rsconnect_0.8.16 Hmisc_4.4-1 lava_1.6.7
## [61] tools_4.0.2 ellipsis_0.3.1 RColorBrewer_1.1-2
## [64] ggridges_0.5.2 plyr_1.8.6 base64enc_0.1-3
## [67] ps_1.4.0 prettyunits_1.1.1 rpart_4.1-15
## [70] pbapply_1.4-2 zoo_1.8-8 qgraph_1.6.5
## [73] haven_2.3.1 cluster_2.1.0 fs_1.4.1
## [76] magrittr_2.0.1 data.table_1.13.2 colourpicker_1.0
## [79] reprex_0.3.0 mvtnorm_1.1-1 whisker_0.4
## [82] sjmisc_2.8.5 matrixStats_0.56.0 hms_0.5.3
## [85] shinyjs_1.1 mime_0.9 evaluate_0.14
## [88] arrayhelpers_1.1-0 xtable_1.8-4 shinystan_2.5.0
## [91] sjstats_0.18.0 jpeg_0.1-8.1 readxl_1.3.1
## [94] gridExtra_2.3 ggeffects_0.14.3 rstantools_2.1.1
## [97] compiler_4.0.2 V8_3.2.0 crayon_1.3.4
## [100] minqa_1.2.4 StanHeaders_2.21.0-6 htmltools_0.5.0
## [103] corpcor_1.6.9 later_1.0.0 Formula_1.2-3
## [106] RcppParallel_5.0.2 lubridate_1.7.9 DBI_1.1.0
## [109] sjlabelled_1.1.7 dbplyr_1.4.3 MASS_7.3-53
## [112] boot_1.3-25 Matrix_1.2-18 cli_2.1.0
## [115] gower_0.2.2 insight_0.10.0 igraph_1.2.5
## [118] BDgraph_2.62 pkgconfig_2.0.3 foreign_0.8-80
## [121] recipes_0.1.13 foreach_1.5.0 xml2_1.3.2
## [124] svUnit_1.0.3 pbivnorm_0.6.0 dygraphs_1.1.1.6
## [127] webshot_0.5.2 prodlim_2019.11.13 estimability_1.3
## [130] rvest_0.3.5 snakecase_0.11.0 callr_3.5.1
## [133] digest_0.6.27 parameters_0.8.6 rmarkdown_2.5
## [136] cellranger_1.1.0 htmlTable_1.13.3 curl_4.3
## [139] shiny_1.5.0 gtools_3.8.2 rjson_0.2.20
## [142] nloptr_1.2.2.2 glasso_1.11 lifecycle_0.2.0
## [145] nlme_3.1-148 jsonlite_1.7.1 viridisLite_0.3.0
## [148] fansi_0.4.1 pillar_1.4.6 loo_2.3.1
## [151] fastmap_1.0.1 httr_1.4.1 pkgbuild_1.1.0
## [154] survival_3.1-12 glue_1.4.2 xts_0.12-0
## [157] fdrtool_1.2.15 iterators_1.0.12 png_0.1-7
## [160] shinythemes_1.1.2 class_7.3-17 stringi_1.4.6
## [163] performance_0.4.6 latticeExtra_0.6-29